;;;
;;;
;;;	Author:	Henry C. Francis
;;;		425 N. Ashe St.
;;;		Southern Pines, NC 28387
;;;		http://paracadd.com
;;;		All rights reserved.
;;;
;;;		COPYRIGHT: 
;;;		   EDITED: 
;;;
(DEFUN c:chkslope ()
  (PRINC "\nSelect station and invert text for 1st manhole: ")
  (PRINC)
  (SETQ chkslope_ss1 (ssget '((0 . "TEXT")(-4 . "<OR")(1 . "*STA*#+##*")(1 . "INV* [IO][NU]*#`.#*")(-4 . "OR>"))))
  (PRINC "\nSelect station and invert text for 2nd manhole: ")
  (PRINC)
  (SETQ chkslope_ss2 (ssget '((0 . "TEXT")(-4 . "<OR")(1 . "*STA*#+##*")(1 . "INV* [IO][NU]*#`.#*")(-4 . "OR>"))))
  (IF (AND
        chkslope_ss1
        chkslope_ss2
        (>(SSLENGTH chkslope_ss1)1)
        (>(SSLENGTH chkslope_ss2)1)
        (<(SSLENGTH chkslope_ss1)4)
        (<(SSLENGTH chkslope_ss2)4)
      )
    (PROGN
      (SETQ ss_cnt 0)
      (WHILE (< ss_cnt (SSLENGTH chkslope_ss1))
        (COND
          ((WCMATCH (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss1 ss_cnt)))) "*STA*#+##*")
           (SETQ sta_txt1 (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss1 ss_cnt))))))
          ((WCMATCH (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss1 ss_cnt)))) "INV* IN*#`.#*")
           (SETQ invin_txt1 (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss1 ss_cnt))))))
          ((WCMATCH (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss1 ss_cnt)))) "INV* OU*#`.#*")
           (SETQ invout_txt1 (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss1 ss_cnt))))))
        )
        (SETQ ss_cnt (1+ ss_cnt))
      )
      (SETQ ss_cnt 0)
      (WHILE (< ss_cnt (SSLENGTH chkslope_ss2))
        (COND
          ((WCMATCH (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss2 ss_cnt)))) "*STA*#+##*")
           (SETQ sta_txt2 (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss2 ss_cnt))))))
          ((WCMATCH (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss2 ss_cnt)))) "INV* IN*#`.#*")
           (SETQ invin_txt2 (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss2 ss_cnt))))))
          ((WCMATCH (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss2 ss_cnt)))) "INV* OU*#`.#*")
           (SETQ invout_txt2 (CDR (ASSOC 1 (ENTGET (SSNAME chkslope_ss2 ss_cnt))))))
        )
        (SETQ ss_cnt (1+ ss_cnt))
      )
      (get_sta_no sta_txt1)
      (setq sta_no1 this_sta)
      (get_inv_no invin_txt1)
      (setq invin_no1 this_no)
      (get_inv_no invout_txt1)      
      (setq invout_no1 this_no)
      (get_sta_no sta_txt2)
      (setq sta_no2 this_sta)
      (get_inv_no invin_txt2)
      (setq invin_no2 this_no)
      (get_inv_no invout_txt2)      
      (setq invout_no2 this_no)
    )
    (COND
        ((OR (NOT chkslope_ss1)
             (<(SSLENGTH chkslope_ss1)2)
             (>(SSLENGTH chkslope_ss1)3)
         )
         (ALERT "For 1st Manhole, Either:\n\tNo station and invert text was selected, or\n\tMore than 1 station, inv out, or inv in text was selected.")
         )
        ((OR (NOT chkslope_ss2)
             (<(SSLENGTH chkslope_ss2)2)
             (>(SSLENGTH chkslope_ss2)3)
         )
         (ALERT "For 2nd Manhole, Either:\n\tNo station and invert text was selected, or\n\tMore than 1 station, inv out, or inv in text was selected.")
         )
    )
  )
  (IF (AND invout_no1 sta_no1 invin_no2 sta_no2 (/= sta_no1 sta_no2))
    (PROGN
      (PRINC (STRCAT "\nSlope=(/(- " (rtos invout_no1 2 2) " " (rtos invin_no2 2 2) ")(- " (rtos sta_no1 2 2) " " (rtos sta_no2 2 2) "))"))
      (PRINC (STRCAT "\nSlope=" (rtos(/(- invout_no1 invin_no2)(- sta_no1 sta_no2)) 2 8)))
      (PRINC)
    )
    (COND
      ((= sta_no1 sta_no2)
       (ALERT "Both stations are the same and\nwould cause a \"divide by zero\" error")
       )
    )
  )
  (PRINC)
)
(defun get_sta_no (tstr / )
     (setq cpos 1
           adjv 0.0)
     (setq strl (strlen tstr))
     (while
       (and
	 (< cpos strl)
	 (setq chrs (substr tstr cpos 1))
	 (or
	   (eq "." chrs)
	   (not(eq (type (read "1")) (type (read chrs))))
	   (eq "+" chrs)
	   (eq "-" chrs)
	   (eq "," chrs)
	 ) ;_ end of or
       ) ;_ end of and
	(setq cpos (1+ cpos))
     ) ;_ end of while
     (setq cpoe cpos)
     (setq cpop cpos)
     (while
       (and
	 (setq chrs (substr tstr cpoe 1))
	 (not (> cpoe strl))
	 (or
	   (eq "." chrs)
	   (eq (type (read "1")) (type (read chrs)))
	   (eq "+" chrs)
	   (eq "-" chrs)
	   (eq "," chrs)
	 ) ;_ end of or
       ) ;_ end of and
	(setq cpoe (1+ cpoe))
     ) ;_ end of while
     (if
       (eq (read "real") (type (read (substr tstr cpos cpoe))))
	(progn
	  (setq	nnum
		 (+ adjv
		    (distof
		      (substr tstr cpos (- cpoe cpos))
		    ) ;_ end of distof
		 ) ;_ end of +
	  ) ;_ end of setq
	  (setq	nstr
		 (strcat
		   (substr tstr 1 (1- cpos))
		   (rtos nnum)
		   (substr tstr cpoe)
		 ) ;_ end of strcat
	  ) ;_ end of setq
	) ;_ end of progn
	(progn
	  (while
	    (and
	      (not (> cpop strl))
	      (setq chrs (substr tstr cpop 1))
	      (not (eq "+" chrs))
	      (not (eq "-" chrs))
	      (not (eq "," chrs))
	    ) ;_ end of and
	     (setq cpop (1+ cpop))
	  ) ;_ end of while
	  (cond
	    ((eq "-" chrs)
	     (setq nsta "T")
	    )
	    ((or(eq "+" chrs)(eq "," chrs))
	     (setq nsta nil)
	    )
	  ) ;_ end of cond
          (if nsta
	    (setq nnum
		   (+ adjv
		      (- 0
			 (distof
			   (if (not (>= cpop (1- strl)))
			     (strcat
			       (substr tstr cpos (- cpop cpos))
			       (substr tstr (1+ cpop) (- cpoe cpop 1))
			     ) ;_ end of strcat
			     (strcat
			       (substr tstr cpos (- cpoe cpos))
			       (substr tstr cpoe)
			     ) ;_ end of strcat
			   ) ;_ end of if
			 ) ;_ end of distof
		      ) ;_ end of -
		   ) ;_ end of +
	    ) ;_ end of setq
	    (setq nnum
		   (+ adjv
		      (distof
			(if (not (>= cpop (1- strl)))
			  (strcat
			    (substr tstr cpos (- cpop cpos))
			    (substr tstr (1+ cpop) (- cpoe cpop 1))
			  ) ;_ end of strcat
			  (strcat
			    (substr tstr cpos (- cpoe cpos))
			    (substr tstr cpoe)
			  ) ;_ end of strcat
			) ;_ end of if
		      ) ;_ end of distof
		   ) ;_ end of +
	    ) ;_ end of setq
	  ) ;_ end of if
	) ;_ end of progn
     ) ;_ end of if
     (setq this_sta nnum)
;;;     (princ "\n")
;;;     (princ this_sta)
     (princ)
)
(defun get_inv_no (tstr / )
	 (IF tstr
	   (PROGN
	     (COND
	       ((WCMATCH tstr "# *#*")
		(SETQ cnt_1 3)
	       )
	       ((WCMATCH tstr "## *#*")
		(SETQ cnt_1 4)
	       )
	       ((WCMATCH tstr "#\"*#*")
		(SETQ cnt_1 4)
	       )
	       ((WCMATCH tstr "##\"*#*")
		(SETQ cnt_1 5)
	       )
	       ((WCMATCH tstr "###\"*#*")
		(SETQ cnt_1 6)
	       )
	       (T
		(setq cnt_1 1)
	       )
	     ) ;_ end of COND
	     (while (and
		      (/= (substr tstr cnt_1 1) "0")
		      (/= (substr tstr cnt_1 1) "1")
		      (/= (substr tstr cnt_1 1) "2")
		      (/= (substr tstr cnt_1 1) "3")
		      (/= (substr tstr cnt_1 1) "4")
		      (/= (substr tstr cnt_1 1) "5")
		      (/= (substr tstr cnt_1 1) "6")
		      (/= (substr tstr cnt_1 1) "7")
		      (/= (substr tstr cnt_1 1) "8")
		      (/= (substr tstr cnt_1 1) "9")
		      (< cnt_1 (strlen tstr))
		    ) ;_ end of and
	       (if (wcmatch (substr tstr cnt_1 5) "%%###")
		 (setq cnt_1 (+ cnt_1 5))
		 (setq cnt_1 (1+ cnt_1))
	       ) ;_ end of if
	     ) ;_ end of while
	     (SETQ cnt_2 1)
	     (while (or
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "0")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "1")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "2")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "3")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "4")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "5")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "6")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "7")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "8")
		      (= (substr tstr (+ cnt_1 cnt_2) 1) "9")
		      (and
			(= (substr tstr (+ cnt_1 cnt_2) 1) ".")
			(not (= (strlen tstr) (+ cnt_1 cnt_2)))
		      ) ;_ end of and
		    ) ;_ end of or
	       (setq cnt_2 (1+ cnt_2))
	     ) ;_ end of while
	     (if (> cnt_1 1)
	       (progn
		 (setq pfx_str (substr tstr 1 (1- cnt_1)))
		 (if (>= (strlen tstr) (+ cnt_1 cnt_2))
		   (setq sfx_str (substr tstr (+ cnt_1 cnt_2)))
		   (setq sfx_str "")
		 ) ;_ end of if
	       ) ;_ end of progn
	       (progn
		 (if (>= (strlen tstr) (1+ cnt_2))
		   (setq sfx_str (substr tstr (1+ cnt_2)))
		   (setq sfx_str "")
		 ) ;_ end of if
		 (setq pfx_str "")
	       ) ;_ end of progn
	     ) ;_ end of if
             (if (and (eq pfx_str "") (eq sfx_str ""))
               (setq newno (+ (distof tstr 2) adjv))
               (setq newno (fix_no))
             )
             (setq this_no newno)
;;;             (princ "\n")
;;;             (princ this_no)
;;;             (princ)
;;;             (princ)
	   ) ;_ end of PROGN
	 ) ;_ end of IF
)
(DEFUN fix_no ()
  (SETQ	fixed_str_prec
	 (if
	   (and	(/= pfx_str "")
		(eq (substr pfx_str (strlen pfx_str)) "-")
		(> cnt_1 1)
		(< (distof (substr tstr (1- cnt_1) (1+ cnt_2)) 2)
		   0
		) ;_ end of <
	   ) ;_ end of and
	    (PROGN
;;;		    (PRINC "\nOriginal number is negative! ")
;;;		    (PRINC)
		(ABS
		  (+ (distof
		       (strcat (substr pfx_str (strlen pfx_str))
			       (substr tstr cnt_1 cnt_2)
		       ) ;_ end of strcat
		       2
		     ) ;_ end of distof
		     adjv
		  ) ;_ end of +
		) ;_ end of ABS
	    ) ;_ end of PROGN
	    (PROGN
;;;		    (PRINC "\nOriginal number is positive! ")
;;;		    (PRINC)
	      (+ (distof (substr tstr cnt_1 cnt_2) 2) adjv)
	    ) ;_ end of PROGN
	 ) ;_ end of if
  ) ;_ end of SETQ
  (IF (> ndpl 0)
    (PROGN
      (IF
	(NOT(WCMATCH fixed_str_prec "*#.#*"))
	(PROGN
	  (SETQ fixed_str_prec (STRCAT fixed_str_prec "."))
	  (REPEAT ndpl (SETQ fixed_str_prec (STRCAT fixed_str_prec "0")))
	)
	(PROGN
	  (SETQ temp_str fixed_str_prec)
	  (WHILE (NOT (WCMATCH (SETQ temp_str (SUBSTR temp_str 2)) ".#*")))
          (REPEAT (- ndpl(1-(STRLEN temp_str)))(SETQ fixed_str_prec (STRCAT fixed_str_prec "0")))
	)
      )
    )
  )
  (EVAL fixed_str_prec)
) ;_ end of DEFUN
